home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fastview / modfastv.bas < prev    next >
BASIC Source File  |  1999-01-14  |  7KB  |  200 lines
  1. Attribute VB_Name = "modFastView32"
  2. '*******************************************************
  3. ' FastView32 was written mostly by Ryan Martinsen
  4. ' Image Map Maker - written by Theo Kandiliotis - ionikh@hol.gr
  5. ' I don't know who wrote the code for Inverting Colors
  6. '
  7. ' If you use any of this code I would appreciate it if
  8. ' you would send me any improvements made to the code or
  9. ' interface design.
  10. ' Please use credit where due.
  11. '
  12. ' E-mail: ryan@homeonthewww.com
  13. ' Web:    http://www.homeonthewww.com/ryan/
  14. '*******************************************************
  15.  
  16. ' On Top Sub Declaration
  17. Public Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  18.  
  19. Dim chrs, chrsin, chrsout, idx
  20.  
  21. ' Drag Drop Code Stuff
  22. Type POINTAPI
  23.  x As Long
  24.  y As Long
  25. End Type
  26.  
  27. Type msg
  28.  hwnd As Long
  29.  message As Long
  30.  wParam As Long
  31.  lParam As Long
  32.  time As Long
  33.  pt As POINTAPI
  34. End Type
  35.  
  36. Public Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)
  37. Public Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long)
  38. Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
  39. Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
  40. Public Const PM_NOREMOVE = &H0
  41. Public Const PM_NOYIELD = &H2
  42. Public Const PM_REMOVE = &H1
  43. Public Const WM_DROPFILES = &H233
  44.  
  45. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  46. Const WM_CLOSE = &H10
  47. Const WM_SYSCOMMAND = &H112
  48. Const SC_CLOSE = &HF060
  49. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  50.  
  51. Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  52. Public Const SW_NORMAL = 1
  53.  
  54. 'Integer that holds the total of regions on the
  55. 'image map
  56. Public NofRegions As Integer
  57.  
  58. Public Region(100, 6)
  59. 'An array that holds all the information of all
  60. 'the regions on the image map:
  61. '
  62. 'Region(x,y)
  63. '
  64. 'x
  65. '-> an integer ,the index of the region
  66. 'It's  0 <= x <= NofRegions and there can be
  67. 'up to 100 regions on one image map.
  68. '
  69. 'Region(x,1) , Region(x,2) , Region(x,3) , Region(x,4)
  70. '-> The coordinates of the two pixels that define
  71. 'the rectangular region
  72. '
  73. 'Region(x,5)
  74. '-> A string that holds the URL that the region will
  75. '-> lead to
  76. '
  77. 'Region(x,6)
  78. '-> A string that holds the name of the frame in
  79. 'which the new HTML file will load in
  80.  
  81. Public ScreenRes
  82. Public TWidth
  83. Public THeight
  84. Public Sub WatchForFiles()
  85. On Error GoTo err1
  86. 'This watches for all WM_DROPFILES messages
  87. Dim FileDropMessage As msg 'Msg Type
  88. Dim fileDropped As Boolean 'True if Files where dropped
  89. Dim hDrop As Long 'Pointer to the dropped file structure
  90. Dim filename As String * 128 'the dropped filename
  91. Dim numOfDroppedFiles As Long 'the number of dropped files
  92. Dim curFile As Long 'the current file number
  93. 'loop to keep checking for files
  94. 'NOTE: Do any code you want to execute before this set
  95.  
  96. Do
  97.  
  98. 'check for Dropped file messages
  99. fileDropped = PeekMessage(FileDropMessage, 0, WM_DROPFILES, WM_DROPFILES, PM_REMOVE Or PM_NOYIELD)
  100.  
  101. If fileDropped Then
  102.  
  103. 'get the pointer to the dropped file structure
  104. hDrop = FileDropMessage.wParam
  105.  
  106. 'get the total number of files
  107. numOfDroppedFiles = DragQueryFile(hDrop, True, filename, 127)
  108. For curFile = 1 To numOfDroppedFiles
  109.  
  110. 'get the file name
  111. ret = DragQueryFile(hDrop, curFile - 1, filename, 127)
  112.  
  113. 'at this pointer you can do what you want with the filename
  114.  
  115. 'the filename will be a full qualified path
  116. If Right$(filename, 4) = ".htm" Or Right$(filename, 4) = ".css" Or Right$(filename, 4) = ".txt" Or Right$(filename, 4) = "html" Or Right$(filename, 4) = ".asp" Or Right$(filename, 4) = "shtm" Then
  117.  MsgBox filename
  118.  frmFastViewHTML.Show
  119.  frmFastViewHTML.WebBrowser1.Navigate filename
  120.  frmFastView.Hide
  121. Else
  122.  frmFastView.MousePointer = vbHourglass
  123.  Set frmFastView.picImage = LoadPicture(filename)
  124.  frmFastView.Width = frmFastView.picImage.Width + 95
  125.  frmFastView.Height = frmFastView.picImage.Height + 665
  126.  frmFastView.picGet.Height = frmFastView.picImage.Height
  127.  frmFastView.picGet.Width = frmFastView.picImage.Width
  128.  
  129.  frmFastView.txtFilename.Text = filename
  130.  frmFastView.txtFilename.Text = ExtractName(frmFastView.txtFilename.Text)
  131.  
  132.  frmFastView.Caption = "FastView32 - " & frmFastView.txtFilename.Text & " (" & frmFastView.picGet.ScaleWidth & " x " & frmFastView.picGet.ScaleHeight & ")"
  133.  
  134.  frmFastView.Move (Screen.Width - frmFastView.Width) \ 2, (Screen.Height - frmFastView.Height) \ 2
  135.  frmFastView.MousePointer = Default
  136. End If
  137. Next curFile
  138.  
  139. 'we are now done with the structure, tell windows to discard it
  140. DragFinish (hDrop)
  141. End If
  142.  
  143. DoEvents
  144. Loop
  145. Exit Sub
  146. err1:
  147. Exit Sub
  148. End Sub
  149. Private Sub Main()
  150. If App.PrevInstance = True Then
  151. Dim Handle As Integer, x As Integer
  152.  
  153. Handle = FindWindow(vbNullString, "FastView32 Hidden Window")
  154. If Handle <> 0 Then x = SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0&)
  155. End If
  156.  
  157. frmFastView.Show
  158. WatchForFiles
  159. End Sub
  160. Function ExtractName(chrsin As String)
  161.  
  162. If InStr(chrsin, "\") Then 'check to see if a forward slash exists
  163.    For idx = Len(chrsin) To 1 Step -1 'step though until full name is extracted
  164.        If Mid(chrsin, idx, 1) = "\" Then
  165.           chrsout = Mid(chrsin, idx + 1)
  166.           Exit For
  167.        End If
  168.    Next idx
  169. ElseIf InStr(chrsin, ":") = 2 Then 'otherwise, check to see if a colon exists
  170.    chrsout = Mid(chrsin, 3)        'if so, return the filename
  171. Else
  172.    chrsout = chrsin 'otherwise, return the original string
  173. End If
  174.  
  175. ExtractName = chrsout 'return the filename to the user
  176.  
  177. End Function
  178. Public Sub OnTop(hwnd As Long)
  179. ' OnTop hWnd
  180.  
  181. Call SetWindowPos _
  182. (hwnd, -1, 0, 0, 0, 0, &H2 Or &H1)
  183.  
  184.  
  185. ' OffTop hWnd
  186. ' frmAbout.Show vbModal
  187. ' OnTop hWnd
  188. End Sub
  189.  
  190.  
  191. Public Sub OffTop(hwnd As Long)
  192.  
  193. ' OffTop hWnd
  194.  
  195. Call SetWindowPos _
  196. (hwnd, -2, 0, 0, 0, 0, &H2 Or &H1)
  197.  
  198. End Sub
  199.  
  200.